home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Nordlicht Spiele
/
Nordlicht Spiele 05-04 (19xx)(Nordlicht)(DE)(PD).zip
/
Nordlicht Spiele 05-04 (19xx)(Nordlicht)(DE)(PD).adf
/
Genius.mod
< prev
next >
Wrap
Text File
|
1996-12-24
|
8KB
|
359 lines
MODULE Genius; (* HAK/26aug88 *)
FROM Dos IMPORT Close,Delay,FileHandlePtr,Open,Read;
FROM Exec IMPORT AllocMem,CopyMem,FreeMem,MemReqs,MemReqSet;
FROM Graphics IMPORT BitMapPtr,LoadRGB4,RastPortPtr,SetRGB4,ViewModeSet,
ViewPortPtr;
FROM Intuition IMPORT ClearPointer,CloseScreen,CloseWindow,customScreen,
DrawImage,IDCMPFlagSet,Image,NewScreen,NewWindow,
ScreenPtr,SetPointer,OpenScreen,OpenWindow,WindowFlags,
WindowFlagSet,WindowPtr;
FROM SYSTEM IMPORT ADR,ADDRESS,INLINE;
VAR
chxp : CARDINAL;
chyp : CARDINAL;
comc : ARRAY [0..4] OF CARDINAL;
comp : ARRAY [0..4] OF CARDINAL;
du10 : LONGINT;
du20 : CARDINAL;
du21 : CARDINAL;
imag : Image;
kor0 : CARDINAL;
kor1 : CARDINAL;
lop0 : BOOLEAN;
lop1 : BOOLEAN;
moux : INTEGER;
mouy : INTEGER;
ciaa[0BFE001H] : SET OF [0..7];
pics : ADDRESS;
potr : ADDRESS;
rapp : RastPortPtr;
rand[0DFF006H] : CARDINAL;
scrn : ScreenPtr;
succ : BOOLEAN;
vipp : ViewPortPtr;
wind : WindowPtr;
PROCEDURE OpenScr():ScreenPtr;
VAR
nscr : NewScreen;
scpt : ScreenPtr;
BEGIN
WITH nscr DO
leftEdge:=0;
topEdge:=0;
width:=320;
height:=256;
depth:=5;
detailPen:=0;
blockPen:=0;
viewModes:=ViewModeSet{};
type:=customScreen;
font:=NIL;
defaultTitle:=NIL;
gadgets:=NIL;
customBitMap:=NIL;
END;
scpt:=OpenScreen(nscr);
RETURN(scpt);
END OpenScr;
PROCEDURE OpenWin(scpt:ScreenPtr):WindowPtr;
VAR
nwin : NewWindow;
wipt : WindowPtr;
BEGIN
WITH nwin DO
leftEdge:=0;
topEdge:=0;
width:=320;
height:=256;
detailPen:=0;
blockPen:=0;
idcmpFlags:=IDCMPFlagSet{};
flags:=WindowFlagSet{activate,rmbTrap};
firstGadget:=NIL;
checkMark:=NIL;
title:=NIL;
screen:=scpt;
bitMap:=NIL;
minWidth:=320;
minHeight:=256;
maxWidth:=320;
maxHeight:=256;
type:=customScreen;
END;
wipt:=OpenWindow(nwin);
RETURN(wipt);
END OpenWin;
PROCEDURE SetColors1;
VAR
colr : CARDINAL;
BEGIN
FOR colr:=0 TO 31 DO
SetRGB4(vipp,colr,0,0,0);
END;
END SetColors1;
PROCEDURE Colortable;
BEGIN
INLINE(0000H,0BBBH,0D90H,0999H,0777H,0DDDH,0AAAH);
INLINE(0FB0H,0A60H,0666H,0555H,0CCCH,0F0FH,0720H);
INLINE(00C3H,000FH,0F00H,0F8BH,0000H,0FF0H,0FE0H,0FFFH);
END Colortable;
PROCEDURE Loaddata;
VAR
bimp : BitMapPtr;
bipp : ADDRESS;
fihp : FileHandlePtr;
plsc : INTEGER;
BEGIN
bimp:=rapp^.bitMap;
pics:=AllocMem(5930,MemReqSet{chip,memClear});
fihp:=Open(ADR("Genius-Data"),1005);
FOR plsc:=0 TO 4 DO
bipp:=bimp^.planes[plsc];
du10:=Read(fihp,bipp,10240);
END;
du10:=Read(fihp,pics,5930);
Close(fihp);
END Loaddata;
PROCEDURE Pointerdata;
BEGIN
INLINE(00000H,00000H);
INLINE(00000H,00800H,00800H,01400H,00800H,01400H,00800H,01400H);
INLINE(00800H,016A0H,00AA0H,05550H,04AA0H,0B550H,06AA0H,09550H);
INLINE(03FE0H,04010H,01FC0H,02020H,00FC0H,01020H,00F80H,01040H);
INLINE(00000H,03FE0H,01FC0H,03FE0H,017C0H,03FE0H,01FC0H,03FE0H);
INLINE(00000H,00000H);
END Pointerdata;
PROCEDURE Pointer;
BEGIN
potr:=AllocMem(72,MemReqSet{chip,memClear});
CopyMem(ADR(Pointerdata)+10,potr,72);
SetPointer(wind,potr,16,16,-5,-1);
END Pointer;
PROCEDURE ChooseCombination;
BEGIN
FOR du20:=0 TO 4 DO
succ:=FALSE;
WHILE succ=FALSE DO
succ:=TRUE;
comc[du20]:=rand MOD 7;
FOR du21:=0 TO du20 DO
IF (du20#du21) AND (comc[du20]=comc[du21]) THEN
succ:=FALSE;
END;
END;
END;
END;
chxp:=0;
chyp:=7;
END ChooseCombination;
PROCEDURE CheckMouse;
BEGIN
WHILE (6 IN ciaa) DO
END;
moux:=scrn^.mouseX;
mouy:=scrn^.mouseY;
Delay(5);
WHILE (6 IN ciaa)=FALSE DO
END;
succ:=TRUE;
IF (moux>226) AND (mouy<36) THEN
lop1:=FALSE;
ELSE
IF (moux<25) OR (moux>45) THEN
succ:=FALSE;
ELSIF (mouy>37) AND (mouy<57) THEN
comp[chxp]:=0;
ELSIF (mouy>69) AND (mouy<89) THEN
comp[chxp]:=1;
ELSIF (mouy>101) AND (mouy<121) THEN
comp[chxp]:=2;
ELSIF (mouy>133) AND (mouy<153) THEN
comp[chxp]:=3;
ELSIF (mouy>165) AND (mouy<185) THEN
comp[chxp]:=4;
ELSIF (mouy>197) AND (mouy<217) THEN
comp[chxp]:=5;
ELSIF (mouy>229) AND (mouy<249) THEN
comp[chxp]:=6;
ELSE
succ:=FALSE;
END;
FOR du20:=0 TO chxp DO
IF (comp[du20]=comp[chxp]) AND (du20#chxp) THEN
succ:=FALSE;
END;
END;
END;
END CheckMouse;
PROCEDURE SetChip;
BEGIN
imag.width:=15;
imag.height:=13;
imag.imageData:=pics+4690+LONGINT(130*comp[chxp]);
DrawImage(rapp,ADR(imag),91+25*INTEGER(chxp),57+24*INTEGER(chyp));
chxp:=chxp+1;
END SetChip;
PROCEDURE CheckRow;
BEGIN
kor0:=0;
kor1:=0;
FOR du20:=0 TO 4 DO
IF comp[du20]=comc[du20] THEN
kor0:=kor0+1;
END;
END;
IF kor0=5 THEN
lop1:=FALSE;
END;
FOR du20:=0 TO 4 DO
FOR du21:=0 TO 4 DO
IF (du20#du21) AND (comp[du20]=comc[du21]) THEN
kor1:=kor1+1;
END;
END;
END;
du20:=0;
du21:=kor0;
imag.width:=8;
imag.height:=11;
imag.imageData:=pics+5710;
WHILE du21>0 DO
DrawImage(rapp,ADR(imag),227+10*INTEGER(du20),58+24*INTEGER(chyp));
du21:=du21-1;
du20:=du20+1;
END;
imag.imageData:=pics+5820;
WHILE kor1>0 DO
DrawImage(rapp,ADR(imag),227+10*INTEGER(du20),58+24*INTEGER(chyp));
kor1:=kor1-1;
du20:=du20+1;
END;
END CheckRow;
PROCEDURE ShowCombination;
BEGIN
imag.width:=15;
imag.height:=13;
FOR du20:=0 TO 4 DO
imag.imageData:=pics+4690+LONGINT(comc[du20]*130);
DrawImage(rapp,ADR(imag),91+25*INTEGER(du20),17);
END;
imag.width:=95;
imag.height:=38;
imag.imageData:=pics+2280;
DrawImage(rapp,ADR(imag),225,0);
END ShowCombination;
PROCEDURE ChipClear;
BEGIN
imag.width:=15;
imag.height:=13;
imag.imageData:=pics+4560;
FOR du20:=0 TO 4 DO
DrawImage(rapp,ADR(imag),91+25*INTEGER(du20),17);
END;
FOR du20:=0 TO 7 DO
FOR du21:=0 TO 4 DO
DrawImage(rapp,ADR(imag),91+25*INTEGER(du21),57+24*INTEGER(du20));
END;
END;
imag.width:=8;
imag.height:=11;
imag.imageData:=pics+5600;
FOR du20:=0 TO 7 DO
FOR du21:=0 TO 4 DO
DrawImage(rapp,ADR(imag),227+10*INTEGER(du21),58+24*INTEGER(du20));
END;
END;
imag.width:=95;
imag.height:=38;
imag.imageData:=pics;
DrawImage(rapp,ADR(imag),225,0);
END ChipClear;
PROCEDURE Continue;
BEGIN
succ:=FALSE;
WHILE succ=FALSE DO
WHILE (6 IN ciaa) DO
END;
moux:=scrn^.mouseX;
mouy:=scrn^.mouseY;
WHILE (6 IN ciaa)=FALSE DO
END;
IF (moux>226) AND (moux<265) AND
(mouy>1) AND (mouy<36) THEN
lop0:=FALSE;
succ:=TRUE;
END;
IF (moux>264) AND (moux<318) AND
(mouy>1) AND (mouy<36) THEN
ChipClear;
succ:=TRUE;
END;
END;
END Continue;
BEGIN
scrn:=OpenScr();
wind:=OpenWin(scrn);
vipp:=ADR(scrn^.viewPort);
rapp:=ADR(scrn^.rastPort);
SetColors1;
Pointer;
Loaddata;
WITH imag DO
leftEdge:=0;
topEdge:=0;
depth:=5;
planePick:=31;
planeOnOff:=0;
nextImage:=NIL;
END;
LoadRGB4(vipp,ADR(Colortable)+10,22);
lop0:=TRUE;
REPEAT
ChooseCombination;
lop1:=TRUE;
REPEAT
CheckMouse;
IF (lop1=TRUE) AND (succ=TRUE) THEN
SetChip;
IF chxp=5 THEN
CheckRow;
IF chyp=0 THEN
lop1:=FALSE;
ELSE
chxp:=0;
chyp:=chyp-1;
END;
END;
END;
UNTIL lop1=FALSE;
ShowCombination;
Continue;
UNTIL lop0=FALSE;
FreeMem(pics,5930);
ClearPointer(wind);
FreeMem(potr,72);
CloseWindow(wind);
CloseScreen(scrn);
END Genius.